home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / contrib / zelk / src-elk / main.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-13  |  6.6 KB  |  304 lines
  1. #include "scheme.h"
  2.  
  3. #if ZELK
  4. # include <zelk.h>
  5. #endif
  6.  
  7. #ifdef INCLUDE_UNISTD_H
  8. #  include <unistd.h>
  9. #endif
  10. #include TIME_H
  11. #ifndef MAX_STACK_SIZE
  12. #  include <sys/resource.h>
  13. #endif
  14. #include <sys/types.h>
  15. #include <sys/param.h>
  16. #include <sys/stat.h>
  17. #include <sys/file.h>
  18.  
  19. extern char *getenv();
  20.  
  21. char *stkbase;
  22. int Max_Stack;
  23. int Interpreter_Initialized;
  24. int GC_Debug = 0;
  25. int Case_Insensitive;
  26. int Verbose;
  27.  
  28. char **Argv;
  29. int Argc, First_Arg;
  30.  
  31. #if defined(USE_LD) || defined(CAN_DUMP) || defined(INIT_OBJECTS)
  32. char *A_Out_Name;
  33. char *Find_Executable();
  34. #endif
  35.  
  36. #if defined(CAN_LOAD_OBJ) || defined(INIT_OBJECTS)
  37. SYMTAB *The_Symbols;
  38. #endif
  39.  
  40. void Exit_Handler () {
  41. #if defined(CAN_LOAD_OBJ) || defined(INIT_OBJECTS)
  42.     Call_Finalizers ();
  43. #endif
  44. #ifdef USE_LD
  45.     Finit_Load ();
  46. #endif
  47. }
  48.  
  49. #ifndef ATEXIT
  50. void exit (n) {
  51.     Exit_Handler ();
  52.     _cleanup ();
  53.     _exit (n);
  54. }
  55. #endif
  56.  
  57. #ifdef CAN_DUMP
  58. int Was_Dumped;
  59. #endif
  60.  
  61. /* To avoid that the stack copying code overwrites argv if a dumped
  62.  * copy of the interpreter is invoked with more arguments than the
  63.  * original a.out, move the stack base INITIAL_STK_OFFSET bytes down:
  64.  */
  65.  
  66. main (ac, av) char **av; {
  67. #ifdef CAN_DUMP
  68.     char unused[INITIAL_STK_OFFSET];
  69. #endif
  70.     register char *initfile, *loadfile = 0, *loadpath = 0;
  71.     register debug = 0, heap = HEAP_SIZE;
  72.     Object file;
  73.     char foo;
  74.  
  75.     if (ac == 0) {
  76.     av[0] = "Elk"; ac = 1;
  77.     }
  78.     Get_Stack_Limit ();
  79.  
  80. #if defined(USE_LD) || defined(CAN_DUMP) || defined(INIT_OBJECTS)
  81.     A_Out_Name = Find_Executable (av[0]);
  82. #endif
  83.  
  84.     Argc = ac; Argv = av;
  85.     First_Arg = 1;
  86. #ifdef CAN_DUMP
  87.     if (Was_Dumped) {
  88.     Loader_Input[0] = '\0';
  89.     Install_Intr_Handler ();
  90.     (void)Funcall_Control_Point (Dump_Control_Point, Arg_True, 0);
  91.     /*NOTREACHED*/
  92.     }
  93. #endif
  94.  
  95.     for ( ; First_Arg < ac; First_Arg++) {
  96.     if (strcmp (av[First_Arg], "-g") == 0) {
  97.         debug = 1;
  98.     } else if (strcmp (av[First_Arg], "-i") == 0) {
  99.         Case_Insensitive = 1;
  100.     } else if (strcmp (av[First_Arg], "-v") == 0) {
  101.         Verbose = 1;
  102.     } else if (strcmp (av[First_Arg], "-h") == 0) {
  103.         if (++First_Arg == ac)
  104.         Usage ();
  105.         heap = atoi (av[First_Arg]);
  106.     } else if (strcmp (av[First_Arg], "-l") == 0) {
  107.         if (++First_Arg == ac || loadfile)
  108.         Usage ();
  109.         loadfile = av[First_Arg];
  110.     } else if (strcmp (av[First_Arg], "-p") == 0) {
  111.         if (++First_Arg == ac || loadpath)
  112.         Usage ();
  113.         loadpath = av[First_Arg];
  114.     } else if (strcmp (av[First_Arg], "--") == 0) {
  115.         First_Arg++;
  116.         break;
  117.     } else if (av[First_Arg][0] == '-') {
  118.         Usage ();
  119.     } else {
  120.         break;
  121.     }
  122.     }
  123.  
  124.     stkbase = &foo;
  125.     ALIGN(stkbase);
  126.     Make_Heap (heap);
  127.     Init_Everything ();
  128. #ifdef ATEXIT
  129.     if (atexit (Exit_Handler) != 0)
  130.     Fatal_Error ("atexit returned non-zero value");
  131. #endif
  132. #ifdef INIT_OBJECTS
  133.     if (Should_Init_Objects ()) {
  134.     Error_Tag = "init-objects";
  135.     The_Symbols = Open_File_And_Snarf_Symbols (A_Out_Name);
  136.     (void)Call_Initializers (The_Symbols, (char *)0);
  137.     }
  138. #endif
  139.     if (loadpath)
  140.     Init_Loadpath (loadpath);
  141.     
  142.     Error_Tag = "scheme-init";
  143.     initfile = INITFILE;
  144.     file = Make_String (initfile, strlen (initfile));
  145.     (void)General_Load (file, The_Environment);
  146.  
  147.     Install_Intr_Handler ();
  148.  
  149.     Error_Tag = "top-level";
  150.     if (loadfile == 0)
  151.     loadfile = "toplevel";
  152.     file = Make_String (loadfile, strlen (loadfile));
  153.     Interpreter_Initialized = 1;
  154.     GC_Debug = debug;
  155.     if (loadfile[0] == '-' && loadfile[1] == '\0')
  156.     Load_Source_Port (Standard_Input_Port);
  157.     else
  158.     (void)General_Load (file, The_Environment);
  159.     return 0;
  160. }
  161.  
  162. static char *Usage_Msg[] = {
  163.     "Options:",
  164.     "   [-l filename]   Load file instead of standard toplevel",
  165.     "   [-l -]          Load from standard input",
  166.     "   [-h heapsize]   Heap size in KBytes",
  167.     "   [-p loadpath]   Initialize load-path (comma-list of directories)",
  168.     "   [-g]            Enable GC-debugging",
  169.     "   [-i]            Case-insensitive symbols",
  170.     "   [-v]            Verbose mode (print linker commands)",
  171.     "   [--]            End options and begin arguments",
  172.     0 };
  173.  
  174. Usage () {
  175.     char **p;
  176.  
  177.     fprintf (stderr, "Usage: %s [options] [arguments]\n", Argv[0]);
  178.     for (p = Usage_Msg; *p; p++)
  179.     fprintf (stderr, "%s\n", *p);
  180.     exit (1);
  181. }
  182.  
  183. Init_Everything () {
  184.     Init_String ();
  185.     Init_Symbol ();
  186.     Init_Env ();
  187.     Init_Error ();
  188.     Init_Exception ();
  189.     Init_Io ();
  190.     Init_Prim();
  191.     Init_Math ();
  192.     Init_Print ();
  193.     Init_Auto ();
  194.     Init_Heap ();
  195.     Init_Load ();
  196.     Init_Proc ();
  197.     Init_Special ();
  198.     Init_Read ();
  199.     Init_Features ();
  200.     Init_Terminate ();
  201. #ifdef CAN_DUMP
  202.     Init_Dump ();
  203. #endif
  204. #if ZELK
  205.     Init_Zelk ();
  206. #endif
  207. }
  208.  
  209. Get_Stack_Limit () {
  210. #ifdef MAX_STACK_SIZE
  211.     Max_Stack = MAX_STACK_SIZE;
  212. #else
  213.     struct rlimit rl;
  214.  
  215.     if (getrlimit (RLIMIT_STACK, &rl) == -1) {
  216.     perror ("getrlimit");
  217.     exit (1);
  218.     }
  219.     Max_Stack = rl.rlim_cur;
  220. #endif
  221.     Max_Stack -= STACK_MARGIN;
  222. }
  223.  
  224. #if defined(USE_LD) || defined(CAN_DUMP) || defined(INIT_OBJECTS)
  225. Executable (fn) char *fn; {
  226.     struct stat s;
  227.  
  228.     return stat (fn, &s) != -1 && (s.st_mode & S_IFMT) == S_IFREG
  229.         && access (fn, X_OK) != -1;
  230. }
  231.  
  232. char *Find_Executable (fn) char *fn; {
  233.     char *path, *getenv();
  234.     static char buf[1025];  /* Can't use Path_Max or Safe_Malloc here */
  235.     register char *p;
  236.  
  237.     for (p = fn; *p; p++) {
  238.     if (*p == '/') {
  239.         if (Executable (fn))
  240.         return fn;
  241.         else
  242.         Fatal_Error ("%s is not executable", fn);
  243.     }
  244.     }
  245.     if ((path = getenv ("PATH")) == 0)
  246.     path = ":/usr/ucb:/bin:/usr/bin";
  247.     do {
  248.     p = buf;
  249.     while (*path && *path != ':')
  250.         *p++ = *path++;
  251.     if (*path)
  252.         ++path;
  253.     if (p > buf)
  254.         *p++ = '/';
  255.     strcpy (p, fn);
  256.     if (Executable (buf))
  257.         return buf;
  258.     } while (*path);
  259.     Fatal_Error ("cannot find pathname of %s", fn);
  260.     /*NOTREACHED*/
  261. }
  262. #endif
  263.  
  264. Object P_Command_Line_Args () {
  265.     Object ret, tail;
  266.     register i;
  267.     GC_Node2;
  268.  
  269.     ret = tail = P_Make_List (Make_Fixnum (Argc-First_Arg), Null);
  270.     GC_Link2 (ret, tail);
  271.     for (i = First_Arg; i < Argc; i++, tail = Cdr (tail)) {
  272.     Object a = Make_String (Argv[i], strlen (Argv[i]));
  273.     Car (tail) = a;
  274.     }
  275.     GC_Unlink;
  276.     return ret;
  277. }
  278.  
  279. Object P_Exit (argc, argv) Object *argv; {
  280.     exit (argc == 0 ? 0 : Get_Integer (argv[0]));
  281.     /*NOTREACHED*/
  282. }
  283.  
  284. #ifdef INIT_OBJECTS
  285.  
  286. /* Returns true if DONT_INIT is not defined or if it is defined and
  287.  * argv[0] is not equal to DONT_INIT and doesn't end in a slash followed
  288.  * by DONT_INIT:
  289.  */
  290. Should_Init_Objects () {
  291. #ifdef DONT_INIT
  292.     register char *dont = DONT_INIT;
  293.     register alen = strlen (A_Out_Name), dlen = strlen (dont);
  294.  
  295.     return strcmp (A_Out_Name, dont) != 0 &&
  296.     !(alen > dlen && A_Out_Name[alen-dlen-1] == '/' &&
  297.             strcmp (A_Out_Name + alen - dlen, dont) == 0);
  298. #else
  299.     return 1;
  300. #endif
  301. }
  302.  
  303. #endif /* INIT_OBJECTS */
  304.